home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / acct_rec.frg < prev    next >
Encoding:
Text File  |  1993-03-09  |  6.1 KB  |  297 lines
  1. * Program............: acct_rec.FRG
  2. * Date...............: 3-09-93
  3. * Versions...........: dBASE IV, Report 2.0
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap, ll_heading
  16. ll_heading = .F.
  17.  
  18. *-- Test for no records found
  19. IF EOF() .OR. .NOT. FOUND()
  20.    RETURN
  21. ENDIF
  22.  
  23. *-- turn word wrap mode off
  24. _wrap=.F.
  25.  
  26. IF _plength < (_pspacing * 4 + 1) + (_pspacing * 3 + 1) + 2
  27.    SET DEVICE TO SCREEN
  28.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  29.    ACTIVATE WINDOW gw_report
  30.    @ 0,1 SAY "Increase the page length for this report."
  31.    @ 2,1 SAY "Press any key ..."
  32.    x=INKEY(0)
  33.    DEACTIVATE WINDOW gw_report
  34.    RELEASE WINDOW gw_report
  35.    RETURN
  36. ENDIF
  37.  
  38. _plineno=0          && set lines to zero
  39. *-- NOEJECT parameter
  40. IF gl_noeject
  41.    IF _peject="BEFORE"
  42.       _peject="NONE"
  43.    ENDIF
  44.    IF _peject="BOTH"
  45.       _peject="AFTER"
  46.    ENDIF
  47. ENDIF
  48.  
  49. *-- Set-up environment
  50. ON ESCAPE DO Prnabort
  51. IF SET("TALK")="ON"
  52.    SET TALK OFF
  53.    gc_talk="ON"
  54. ELSE
  55.    gc_talk="OFF"
  56. ENDIF
  57. gc_space=SET("SPACE")
  58. SET SPACE OFF
  59. gc_time=TIME()      && system time for predefined field
  60. gd_date=DATE()      && system date  "    "    "     "
  61. gl_fandl=.F.        && first and last page flag
  62. gl_prntflg=.T.      && Continue printing flag
  63. gl_widow=.T.        && flag for checking widow bands
  64. gn_length=LEN(gc_heading)  && store length of the HEADING
  65. gn_level=2          && current band being processed
  66. gn_page=_pageno     && grab current page number
  67. gn_pspace=_pspacing && get current print spacing
  68.  
  69.  
  70. *-- Set up procedure for page break
  71. gn_atline=_plength - (_pspacing * 3 + 1)
  72. ON PAGE AT LINE gn_atline EJECT PAGE
  73.  
  74. *-- Print Report
  75.  
  76. PRINTJOB
  77.  
  78. *-- Initialize summary variables.
  79. r_msum1=0
  80. r_msum2=0
  81.  
  82. IF gl_plain
  83.    ON PAGE AT LINE gn_atline DO Pgplain
  84. ELSE
  85.    ON PAGE AT LINE gn_atline DO Pgfoot
  86. ENDIF
  87.  
  88. DO Pghead
  89.  
  90. gl_fandl=.T.        && first physical page started
  91.  
  92. DO Rintro
  93.  
  94. *-- File Loop
  95. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  96.    gn_level=0
  97.    *-- Detail lines
  98.    IF gl_summary
  99.       DO Upd_Vars
  100.    ELSE
  101.       DO __Detail
  102.    ENDIF
  103.    gl_widow=.T.         && enable widow checking
  104.    CONTINUE
  105. ENDDO
  106.  
  107. IF gl_prntflg
  108.    DO Rsumm
  109.    IF _plineno <= gn_atline
  110.       EJECT PAGE
  111.    ENDIF
  112. ELSE
  113.    DO Rsumm
  114.    DO Reset
  115.    RETURN
  116. ENDIF
  117.  
  118. ON PAGE
  119.  
  120. ENDPRINTJOB
  121.  
  122. DO Reset
  123. RETURN
  124. * EOP: acct_rec.FRG
  125.  
  126. *-- Update summary fields and/or calculated fields.
  127. PROCEDURE Upd_Vars
  128. *-- Sum
  129. r_msum1=r_msum1+OLDBALANCE
  130. *-- Sum
  131. r_msum2=r_msum2+AMT_OF_BIL
  132. RETURN
  133. * EOP: Upd_Vars
  134.  
  135. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  136. PROCEDURE Prnabort
  137. gl_prntflg=.F.
  138. RETURN
  139. * EOP: Prnabort
  140.  
  141. PROCEDURE Pghead
  142. PRIVATE ll_heading, ln_width
  143. ll_heading = .T.
  144. ln_width = _rmargin - _lmargin
  145. ?
  146. *-- Print HEADING parameter - if it doesn't fit on line one
  147. *-- Value added to gn_length is the last column on line one times two
  148. IF .NOT. gl_plain .AND. gn_length + 160 > ln_width
  149.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width))
  150.    ?
  151.    ll_heading = .F.
  152. ENDIF
  153.  
  154. ?? IIF(gl_plain,'',gd_date) AT 0,;
  155.  IIF(gl_plain,'' , "PAGE  " ) AT 70,;
  156.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  157.  
  158. *-- Print HEADING parameter - if it fits on line one
  159. IF .NOT. gl_plain .AND. gn_length > 0 .AND. ll_heading
  160.    ?? " "
  161.    ?? gc_heading FUNCTION "I;V"+LTRIM(STR(ln_width-(_pcolno*2)))
  162. ENDIF
  163. ?
  164. ?
  165. ?
  166. RETURN
  167. * EOP: Pghead
  168.  
  169. PROCEDURE Rintro
  170. ?
  171. DEFINE BOX FROM 24 TO 57 HEIGHT 4 DOUBLE
  172. ?
  173. ?? "A-T FURNITURE INDUSTRIES" STYLE "B" AT 29
  174. ?
  175. ?? "ACCOUNTS RECEIVABLE REPORT" STYLE "B" AT 28
  176. ?
  177. ?
  178. ?
  179. RETURN
  180. * EOP: Rintro
  181.  
  182. PROCEDURE __Detail
  183. IF 12 * gn_pspace < gn_atline - (_pspacing * 4 + 1)
  184.    IF gl_widow .AND. _plineno+12 * gn_pspace > gn_atline + 1
  185.       EJECT PAGE
  186.    ENDIF
  187. ENDIF
  188. DO Upd_Vars
  189. ?? ;
  190. "──────────────────────────────────────────────────────────────────────";
  191. + "─────────";
  192. AT 0
  193. ?
  194. ?? "INVOICE NUMBER: " STYLE "B" AT 0,;
  195.  Invoice_no FUNCTION "T" STYLE "B" ,;
  196.  "DATE: " STYLE "B" AT 65,;
  197.  Dat_of_bil STYLE "B" 
  198. ?
  199. ?? "CUSTOMER ID: " AT 0,;
  200.  Cust_id FUNCTION "T" 
  201. ?
  202. ?? "PREVIOUS INVOICE #: " AT 6,;
  203.  Invoic_old FUNCTION "T" ,;
  204.  "SENT: " AT 40,;
  205.  Dat_lstbil 
  206. ?
  207. ?? "PREVIOUS INVOICE: $ " AT 6,;
  208.  Amt_lstbil PICTURE "999,999.99" 
  209. ?
  210. ?? "AMOUNT PAID:        " AT 6,;
  211.  Amt_lst_pd PICTURE "999,999.99" 
  212. ?
  213. ?? "----------" AT 26
  214. ?
  215. ?? "PREVIOUS BALANCE: $ " AT 6,;
  216.  Oldbalance PICTURE "999,999.99" 
  217. ?
  218. ?? "CURRENT ORDERS:     " AT 6,;
  219.  Amt_of_cur PICTURE "999,999.99" ,;
  220.  "COMMENTS: " AT 40,;
  221.  Comments FUNCTION "T" 
  222. ?
  223. ?? "==========" AT 26
  224. ?
  225. ?? "CURRENT INVOICE:  $ " AT 6,;
  226.  Amt_of_bil PICTURE "999,999.99" ,;
  227.  "NOTES: " AT 40,;
  228.  Notes FUNCTION "T" 
  229. ?
  230. ?
  231. RETURN
  232. * EOP: __Detail
  233.  
  234. PROCEDURE Rsumm
  235. ?
  236. ?? ;
  237. "══════════════════════════════════════════════════════════════════════";
  238. + "═════════";
  239. AT 0
  240. ?
  241. ?? "TOTAL AMOUNT OF PREVIOUS BALANCES:  $ " AT 0,;
  242.  r_msum1 PICTURE "999,9999.99" 
  243. ?
  244. ?? "TOTAL AMOUNT OF CURRENT INVOICES:   $ " AT 0,;
  245.  r_msum2 PICTURE "999,9999.99" 
  246. ?
  247. ?? ;
  248. "══════════════════════════════════════════════════════════════════════";
  249. + "═════════";
  250. AT 0
  251. gl_fandl=.F.        && last page finished
  252. ?
  253. RETURN
  254. * EOP: Rsumm
  255.  
  256. PROCEDURE Pgfoot
  257. PRIVATE _box, _pspacing
  258. gl_widow=.F.         && disable widow checking
  259. _pspacing=1
  260. ?
  261. IF .NOT. gl_plain
  262.    _pspacing=gn_pspace
  263.    ?
  264.    ?? "PREPARED BY FINANCIAL DEPARTMENT" AT 26
  265.    ?
  266. ENDIF
  267. EJECT PAGE
  268. *-- is the page number greater than the ending page
  269. IF _pageno > _pepage
  270.    GOTO BOTTOM
  271.    SKIP
  272.    gn_level=0
  273. ENDIF
  274. IF .NOT. gl_plain .AND. gl_fandl
  275.    _pspacing=gn_pspace
  276.    DO Pghead
  277. ENDIF
  278. RETURN
  279. * EOP: Pgfoot
  280.  
  281. *-- Process page break when PLAIN option is used.
  282. PROCEDURE Pgplain
  283. PRIVATE _box
  284. EJECT PAGE
  285. RETURN
  286. * EOP: Pgplain
  287.  
  288. *-- Reset dBASE environment prior to calling report
  289. PROCEDURE Reset
  290. SET SPACE &gc_space.
  291. SET TALK &gc_talk.
  292. ON ESCAPE
  293. ON PAGE
  294. RETURN
  295. * EOP: Reset
  296.  
  297.